home *** CD-ROM | disk | FTP | other *** search
- ;;; -*- Mode: LISP; Package: BOXER; Syntax: Zetalisp -*-
-
- ;;; (C) Copyright 1985 Massachusetts Institute of Technology
- ;;;
- ;;; Permission to use, copy, modify, distribute, and sell this software
- ;;; and its documentation for any purpose is hereby granted without fee,
- ;;; provided that the above copyright notice appear in all copies and that
- ;;; both that copyright notice and this permission notice appear in
- ;;; supporting documentation, and that the name of M.I.T. not be used in
- ;;; advertising or publicity pertaining to distribution of the software
- ;;; without specific, written prior permission. M.I.T. makes no
- ;;; representations about the suitability of this software for any
- ;;; purpose. It is provided "as is" without express or implied warranty.
- ;;;
-
- ;;; Mapping functions for databases in Boxer.
-
-
- (defboxer-function bu::for-all-boxes ((datafy doit-box-or-name) (port-to box))
- (let* ((thing (get-first-element doit-box-or-name))
- (function (if (symbolp thing)
- (boxer-symeval thing)
- thing))
- (arglist (if (box? function)
- (boxer-arglist function)
- (get-template function)))
- (port-flavor? (and (listp (car arglist))
- (or (eq 'bu::port-to (caar arglist))
- (eq :port-to (caar arglist))))))
- (map-over-inferior-boxes
- (get-port-target box)
- #'(lambda (arg)
- (boxer-funcall function (if port-flavor? arg (copy-box arg nil)))))))
-
- ;;; this is kind of a crock. the both predicate gets run in the lexical environment
- ;;; of the box if it has no inputs or gets the box as an input if it wants an input.
- ;;; that's because tell is so useless.
- (defboxer-function bu::collect-from-all-boxes ((datafy doit-box-or-name) (port-to box))
- (make-box
- (with-collection
- (let* ((thing (get-first-element doit-box-or-name))
- (function (if (symbolp thing)
- (boxer-symeval thing)
- thing))
- (arglist (if (box? function)
- (boxer-arglist function)
- (get-template function)))
- (port-flavor? (and (listp (car arglist))
- (or (eq 'bu::port-to (caar arglist))
- (eq :port-to (caar arglist))))))
- (map-over-inferior-boxes
- (get-port-target box)
- #'(lambda (arg)
- (let ((result
- (if arglist
- (boxer-funcall
- function
- (if port-flavor? arg (copy-box arg nil)))
- (with-static-root-bound arg (boxer-funcall function)))))
- (unless (memq result *returned-values-not-to-print*)
- (collect (list result))))))))))
-
- (defboxer-function bu::collect-template-from-all-boxes ((port-to box) template)
- (make-box
- (with-collection
- (map-over-inferior-boxes
- (get-port-target box)
- #'(lambda (arg)
- (collect
- (let ((result (with-static-root-bound arg (build-internal template))))
- (if (evbox? result)
- (get-evbox-elements result)
- (box-items-list result)))))))))
-
- ;;; this is kind of a crock. the both predicate gets run in the lexical environment
- ;;; of the box if it has no inputs or gets the box as an input if it wants an input.
- ;;; that's because tell is so useless.
- (defboxer-function bu::collect-template-from-some-boxes ((datafy predicate)
- template
- (port-to box))
- (let* ((predicate (get-first-element predicate))
- (function (if (symbolp predicate)
- (boxer-symeval predicate)
- predicate))
- (arglist (cond ((doit-box? function)
- (boxer-arglist function))
- ((functionp function) (get-template function))
- (t nil)))
- (port-flavor? t))
- ;; (and (listp (car arglist))
- ;; (or (eq 'bu::port-to (caar arglist))
- ;; (eq :port-to (caar arglist)))))
- (make-box
- (with-collection
- (map-over-inferior-boxes
- (get-port-target box)
- #'(lambda (arg)
- (when (cond ((true? predicate) t)
- ((null arglist)
- (with-static-root-bound arg
- (true? (boxer-funcall function))))
- (t (true? (boxer-funcall
- function
- (if port-flavor? arg (copy-box arg nil))))))
- (collect
- (let ((result (with-static-root-bound arg
- (build-internal template))))
- (if (evbox? result)
- (get-evbox-elements result)
- (box-items-list result)))))))))))
-
- (defboxer-function bu::self ()
- (make-port-to *boxer-static-variables-root*))
-